home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Interactive 7
/
PC World Interactive 7.iso
/
program
/
qbprog.EXE
/
DISCRIMI.BAS
< prev
next >
Wrap
BASIC Source File
|
1996-05-11
|
14KB
|
493 lines
'***************************************************************************************************
'***************************************************************************************************
'***************************************************************************************************
'***************************************************************************************************
'************** **************
'************** 1 9 9 4 - 1 9 9 5 **************
'************** **************
'************** D I S C R I M I N A N T **************
'***************************************************************************************************
'************** **************
'************** N E S I M R A Z O N **************
'************** **************
'***************************************************************************************************
'***************************************************************************************************
'***************************************************************************************************
'***************************************************************************************************
DECLARE SUB DBUYUK ()
DECLARE SUB EBUYUK ()
DECLARE SUB FBUYUK ()
DECLARE SUB ABUYUK ()
DECLARE SUB BBUYUK ()
DECLARE SUB CBUYUK ()
DEFINT A-Z
DECLARE SUB EKRAN ()
DECLARE SUB FPRINT (x%, y%, yazi$, renk%)
DECLARE SUB renkayar (no%, yesil%, mavi%, kirm%)
DECLARE SUB renkal (no%, y%, m%, k%)
DECLARE SUB Sdraw (A$, Sx AS SINGLE, Sy AS SINGLE, Size AS SINGLE, Wdth, Slope, Col)
DECLARE FUNCTION RNI% (A%)
'$INCLUDE: 'qb.bi'
WIDTH 40: COLOR 14, 1: CLS
LOCATE 5, 12: PRINT "╔══════════════╗"
LOCATE 6, 12: PRINT "║ DISCRIMINANT ║"
LOCATE 7, 12: PRINT "╚══════════════╝"
FPRINT 12, 14, "Nesim RAZON", 4: FPRINT 12, 14, "Presents...", 4
CONST False = 0, TRUE = -1
10660 DATA "mf ml l8 t125 O1b4 e b o2c4 o1e"
10670 DATA "o2c c#4 o1e o2c# c4o1 eo2 c"
10680 DATA "O1b4 e b o2c4 o1e o2c c#4 o1e o2c# c4o1 eo2 c"
10690 DATA "t150mn o3e f#16 f#16 f# f#3o2 e e e"
10700 DATA "mno3e g16 g16 g g3o2 f# F# F#"
10710 DATA "mno3e f#16 f#16 f# f#3o2 e e e"
10720 DATA "mno3e g16 g16 g g3o2 f# F# F#"
10730 DATA "mno3e f#16 f#16 f#f#3o2 e e e"
10740 DATA "mno3e g16 g16 g g3o2 f# F# e"
10750 DATA "mlo4d# o3b64 o4d d2o2 g64 b f#64 a"
10760 DATA "mlg24 b1."
10770 DATA "mno2e f#16 f#16 f# f#3o3 e e e"
10780 DATA "mno2e g16 g16 g g3 o3f# F# F#"
10790 DATA "mno2e f#16 f#16 f# f#3 o3e e e"
10800 DATA "mno2e g16 g16 g g3 o3f# F# F#"
10810 DATA "mno2e f#16 f#16 f# f#3 o3e e e"
10820 DATA "mno2e g16 g16 g g3 o3f# F# e"
10830 DATA "mlo4d# O3b64 o4d d2 o3g64 b f#64 a"
10840 DATA "mlg24 b1."
10850 DATA "t125 O1b4e b o2c4 o1eo2 c c#4 o1e o2c# c4o1 e o2c"
10860 DATA "O1b4 e b o2c4 o1e o2c c#4 o1e o2c# c4o1 e o2c"
10870 DATA "mlo3e e64 g4 o4 d# o3g64 b64 o4d4. o3g"
10880 DATA "f64 a# g64 b2.."
10890 DATA "g7 a32 g32 f#4. o2b o3e c#"
10900 DATA "c#2 o2g64 b64 o3f#6 p16 o2g64 b64 o3f#4"
10910 DATA "mlo3e e64 g4 o4d# o3g64 b64 o4d4. o3g"
10920 DATA "f64 a# g64 b2.."
10930 DATA "g7 a32 g32 f#4. o2b o3d# e"
10940 DATA "e2 o2g64 b64 o3c#6 p16 o2g64 b64 o3c#4"
10950 DATA "mlo3 e e64 g4 o4d# o3g64 b64o4 d4. o3g"
10960 DATA "f64 a# g64 b2.."
10970 DATA "g7 a32 g32 f#4. o2bo3 e c#"
10980 DATA "c#2 o2g64 b64 o3f#6 p16 o2g64 b64 o3f#4"
10990 DATA "mlo3e e64 g4 o4d# o3g64 b64 o4d4. o3g"
11000 DATA "f64 a# g64 b2.."
11010 DATA "g7 a32 g32 f#4. o2bo3 d#e"
11020 DATA "e2 o2g64 b64 o3c#6 p16 o2g64 b64o3 c#4"
11030 DATA "t180o2g64 b64 o3e8 o2g64 b64o3 e4 o2g64 b64 o3e8 o2a64 o3d#64 f#8. e16o2 a64 o3d#64 f#4"
11040 DATA "o2b64 o3e64 g8 o2b64 o3e64 g4 o2b64 o3e64 g8 o2a64 o3d#64 f#8. e16 o2a64 o3d#64 f#4"
11050 DATA "o2g64 b64 o3e8 o2g64 b64 o3e4 o2g64 b64 o3e8 o2a64 o3d#64 f#8. e16o2 a64 o3d#64 f#4"
11060 DATA "o2b64 o3e64 g8 o2b64 o3e64 g4 o2b64 o3e64 g8 o2a64 o3d#64 f#8. e16o2 a64 o3d#64 f#4"
11070 DATA "c#64 e64 g64 b8 c#64 e64 g64 b8 p6 mlo1b2 b8 o3c#64 e64 g64b8 o3c#64 e64 g64 b8"
11080 DATA "t100 p8 o1mlb4. b4o3 c#64 e64 g64 b16 b8 b16 b8 c#64 e64 g64 b8"
11090 DATA "t125O1b4 e bo2 c4 o1e o2c c#4 o1e o2c# c4 o1e o2c"
11100 DATA "t150mno3e f#16 f#16 f# f#3 e e e"
11110 DATA "mno3e g16 g16 g g3 f# F# F#"
11120 DATA "mno3e f#16 f#16 f# f#3 e e e"
11130 DATA "mno3e g16 g16 g g3 f# F# F#"
11140 DATA "mno3e f#16 f#16 f# f#3 e e e"
11150 DATA "mno3e g16 g16 g g3 f# F# e"
11160 DATA "mlo4d# o3b64 o4d d2 g64 b f#64 a"
11170 DATA "mlg24b1."
11180 DATA "mlt125 p16 o2e8 g4 o3d# d4 o2g b"
11190 DATA "b o3f# f4 o2b o3d4 a#"
11200 DATA "a4 f a8 a4 o3d# d"
11210 DATA "d p8 p4 o1e56 b56 o2g56 b56 o3c#56 f#2..
DATA "END"
DIM BondMusic$(1500)
DIM Characters$(128), C1 AS SINGLE, C2 AS SINGLE
DO
READ A$
IF A$ <> "END" THEN
Position = 1
DO
FOR A = Position TO LEN(A$)
IF MID$(A$, A, 1) = " " THEN EXIT FOR
NEXT
BondMusic$(Notes) = MID$(A$, Position, A - Position): Notes = Notes + 1
Position = A + 1
LOOP UNTIL Position > LEN(A$)
END IF
LOOP UNTIL A$ = "END"
Notes = Notes - 1
ON PLAY(2) GOSUB RefreshMusic
GOSUB InvokeMusic
ON TIMER(2) GOSUB CheckKeyboard
TIMER ON
DATA U7E1R3F1D3NL5D4BR2
DATA U8R4F1D2G1NL4F1D2G1NL4BR3
DATA BU1F1R3NE1L3H1U6E1R3F1BR2BD7
DATA U8R4F1D6G1NL4BR3
DATA U8NR5D4NR3D4R5BR2
DATA U8NR5D4NR3D4BR7
DATA U8R4NF1BD8NL4E1U2H1NL1BR3BD4
DATA U8D4R5NU4D4BR2
DATA NR4R2U8NL2R2BR2BD8
DATA BU1NU1F1R3E1NU7BR2BD1
DATA NU8U4R1F4BU8G4BR6BD4
DATA NU8R5BR2
DATA U8F3E3D8BR2
DATA U8F6NU6D2BR2
DATA U8R5D8NL5BR2
DATA U8R4F1D2G1NL4BR3BD4
DATA BU1U6E1R3F1D4G3L1H1BR4NH2F1BR2
DATA U8R4F1D2G1L4R1F4BR2
DATA BU1F1R3E1U2H1L3H1U2E1R3F1BR2BD7
DATA BU8R6L3D8BR5
DATA NU8R5NU8BR2
DATA BU2NU6F2R1E2NU6BR2BD2
DATA NU8E3F3NU8BR2
DATA U1E6U1BL6D1F6D1BR2
DATA BR3U4H2U2BR4D2G2BR4BD4
DATA NR5U2E5U1NL5BR2BD8
DATA bu1u0e1r3u1h1nl2f1d2g1l2nh1r2br2nh1br2
DATA nu8u4r3f1d2g1nl3br3
DATA buu2er3bd4l3nh1br5
DATA buu2er3nu4d4l3nh1br5
DATA buu2er2fgl3d1fr2br3
DATA br2u7er2bd4bl1nl4bd4br2
DATA bd1fr2eu2l3hu1er2fd3br2
DATA u8d4r3fd3br2
DATA br1u4bu2u0br2bd6
DATA bd1fr2eu5bu2u0br2bd6
DATA u8d6r1ne2f2br2
DATA br1nu8br2
DATA u3er0fer0fd3br2
DATA u4r3fd3br2
DATA buu2er2fd2gl2nh1br5
DATA nd2u3er2fd2gnl3br3
DATA buu2er2fd5u2l3nhbr5
DATA u4d2e2rbd4br2
DATA r2ehl1her2br2bd4
DATA br2u6d2nl2r2br2bd4
DATA bunu3fr2enu3br2bd1
DATA br2h2nu2f2e2nu2bd2br2
DATA nu4refrnu4br2
DATA e4bl4f4br2
DATA bunu3fr2nu4d2gl1nhbu3br4
DATA nr3e3unl3br2bd4
FOR A = ASC("A") TO ASC("Z")
READ Characters$(A)
NEXT
FOR A = ASC("a") TO ASC("z")
READ Characters$(A)
NEXT
Characters$(32) = "BR7"
Characters$(63) = "br4u0bu2u1e3h2l3g1BM+8,+7"
Characters$(45) = "BU3R4BR2BD3"
Characters$(39) = "Bu5br1e1u2br3bd8"
Characters$(33) = "u1bu2u5br1bd8"
SCREEN 7, , 2, 0
FOR A = -5 TO 319 STEP 10
LINE (A, 0)-(A, 199), 1
NEXT
FOR A = -5 TO 199 STEP 7
LINE (0, A)-(319, A), 1
NEXT
SCREEN 7, , 1, 0
PCOPY 2, 0
PCOPY 2, 1
DO
SLEEP 1
A$ = "Hello !"
FOR x = 64 TO 4 STEP -4
PSET ((320 - (25 * (x / 4))) / 2, 100), 0
DRAW "C14S" + STR$(x)
FOR A = 1 TO LEN(A$)
DRAW Characters$(ASC(MID$(A$, A, 1)))
NEXT
PCOPY 1, 0: PCOPY 2, 1
NEXT
DRAW "s12"
A$ = "DISCRIMINANT"
C = -1
FOR B = 320 TO -140 STEP -2
PSET (B, C), 0: C = C + 1
DRAW "c14"
FOR A = 1 TO LEN(A$)
DRAW Characters$(ASC(MID$(A$, A, 1)))
NEXT
PCOPY 1, 0: PCOPY 2, 1
NEXT
DRAW "s8"
A$ = "Programmed by"
B = 40
FOR C = -1 TO 230 STEP 2
PSET (B, C), 0
DRAW "c14"
FOR A = 1 TO LEN(A$)
DRAW Characters$(ASC(MID$(A$, A, 1)))
NEXT
PCOPY 1, 0: PCOPY 2, 1
NEXT
A$ = "Nesim RAZON"
C = 100
C2 = 320
C1 = -5
FOR x = 1 TO 230
C1 = C1 + .05
C2 = C2 + C1
PSET (C2, C), 0
DRAW "c14"
FOR A = 1 TO LEN(A$)
DRAW Characters$(ASC(MID$(A$, A, 1)))
NEXT
PCOPY 1, 0: PCOPY 2, 1
NEXT
A$ = "START!"
C = -1
C1 = 0
C2 = 0
B = 125
FOR x = 1 TO 267
C1 = C1 + .025: C2 = C2 + C1: C = C + C2: IF C > 199 THEN C = 199: C2 = -C2
PSET (B, C), 0
DRAW "c14"
FOR A = 1 TO LEN(A$)
DRAW Characters$(ASC(MID$(A$, A, 1)))
NEXT
PCOPY 1, 0: PCOPY 2, 1
NEXT
FOR A = 1 TO 6
FOR B = 8 TO 64 STEP 4
DRAW "BM120,190"
FOR C = 1 TO 6
IF C = A THEN DRAW "S" + STR$(B)
DRAW Characters$(ASC(MID$(A$, C, 1)))
IF C = A THEN DRAW "S8"
NEXT
PCOPY 1, 0: PCOPY 2, 1
NEXT
NEXT
LOOP
END
RefreshMusic:
OK = TRUE
FOR RA = NextNote TO NextNote + RefreshPacket
PLAY "MB" + BondMusic$(RA)
LOCATE 1, 1
NEXT
NextNote = NextNote + RefreshPacket + 1
RefreshPacket = 10
IF NextNote > Notes THEN NextNote = 0
RETURN
InvokeMusic:
NextNote = 0
RefreshPacket = 11
GOSUB RefreshMusic
PLAY ON
RETURN
CheckKeyboard:
IF INKEY$ <> "" THEN
SCREEN 0
WIDTH 80
' PRINT "Thanks for running me!"
GOTO anaprogram
END IF
RETURN
anaprogram:
1 CALL EKRAN
LOCATE 6, 9: PRINT "( x²+ x+ )"
SCREEN 9
COLOR 4: LOCATE 6, 10: PRINT "a": LOCATE 6, 14: PRINT "b": LOCATE 6, 17: PRINT "c":
LOCATE 6, 20: COLOR 1: PRINT "FORMUNDAKI POLINOMLARIN DISKRIMINANTLARINI HESAPLAR..."
12 COLOR 5: LOCATE 11, 20: INPUT "A=", A:
IF A = 0 OR A > 50 THEN GOTO 12
13 LOCATE 11, 40: INPUT "B=", B
IF B = 0 OR B > 50 THEN GOTO 13
14 LOCATE 11, 60: INPUT "C=", C
IF C > 150 THEN GOTO 14
IF B > 0 AND C < 0 THEN CALL CBUYUK
IF B > 0 AND C > 0 THEN CALL BBUYUK
IF B < 0 AND C > 0 THEN CALL ABUYUK
IF B = 0 AND C = 0 THEN CALL DBUYUK
IF B = 0 THEN CALL EBUYUK
IF C = 0 THEN CALL FBUYUK
IF B = 0 AND C > 0 THEN CALL BBUYUK
IF C = 0 AND B > 0 THEN CALL BBUYUK
COLOR 1: LOCATE 12, 30: PRINT A; "x²"
LOCATE 12, 37: PRINT B; "x"
LOCATE 12, 43: PRINT C
DEVAM2:
D = (B * B) - 4 * A * C
DRAW "C0"
DRAW "M120,268"
DRAW "C1"
DRAW "F15L30E15"
COLOR 4: LOCATE 14, 27: PRINT "▄▄▄▄"; : COLOR 1
LOCATE 18, 20: PRINT "= "; D
IF D < 0 THEN GOTO KUCUK
IF D = 0 THEN GOTO ESIT
IF D > 0 THEN GOTO BUYUK
KUCUK:
LOCATE 18, 30: PRINT "(IKI TANE HAYALI KOK VAR...)"
LOCATE 19, 30: PRINT "(COZUM KUMESI YOK...)"
GOTO son
ESIT:
LOCATE 18, 30: PRINT "(IKI TANE ESIT KOK VAR...)"
ESITKOKLER = (-1 * B) / (2 * A)
LOCATE 19, 30: PRINT " X1,2="; ESITKOKLER;
GOTO son
BUYUK:
LOCATE 18, 30: PRINT "(IKI TANE GERCEL KOK VAR...)"
R% = 2 * A
KOK1% = ((-1 * B) + (SQR(D))):
KOK1B% = KOK1% / R%
KOK2% = ((-1 * B) - (SQR(D)))
KOK2B% = KOK2% / R%
LOCATE 19, 30: PRINT " X1="; KOK1% / R%; " "; "X2="; KOK2% / R%
GOTO son
son:
LOCATE 21, 10: INPUT "Devam etmek istiyor musunuz ?"; E$
IF E$ = "e" OR E$ = "E" THEN GOTO 1 ELSE END
'***************************************************************************************************
'***************************************************************************************************
'***************************************************************************************************
SUB ABUYUK
' LOCATE 12, 41: PRINT "+"
LOCATE 12, 42: PRINT "+"
END SUB
SUB BBUYUK
' LOCATE 12, 35: PRINT "+"
' LOCATE 12, 41: PRINT "+"
LOCATE 12, 36: PRINT "+"
LOCATE 12, 42: PRINT "+"
END SUB
SUB CBUYUK
' LOCATE 12, 35: PRINT "+":
LOCATE 12, 36: PRINT "+":
END SUB
SUB DBUYUK
' LOCATE 12, 35: PRINT "+"
' LOCATE 12, 41: PRINT "+"
LOCATE 12, 36: PRINT "+"
LOCATE 12, 42: PRINT "+"
END SUB
SUB EBUYUK
' LOCATE 12, 35: PRINT "+":
LOCATE 12, 36: PRINT "+":
END SUB
SUB EKRAN
CLS
SCREEN 9: COLOR 4, 3
LOCATE 1, 1: PRINT "█";
FOR I = 1 TO 78
PRINT "▀";
NEXT I
PRINT "█";
FOR I = 2 TO 21
LOCATE I, 1: PRINT "█"
NEXT I
PRINT "█";
FOR I = 1 TO 78
PRINT "▄";
NEXT I
PRINT "█";
FOR I = 2 TO 22
LOCATE I, 80: PRINT "█"
NEXT I
LOCATE 3, 1: PRINT "█";
FOR I = 1 TO 78
PRINT "▄";
NEXT I
PRINT "█";
LOCATE 9, 1: PRINT "█";
FOR I = 1 TO 78
PRINT "▄";
NEXT I
PRINT "█";
LOCATE 14, 1: PRINT "█";
FOR I = 1 TO 78
PRINT "▄";
NEXT I
PRINT "█";
COLOR 9, 3: LOCATE 2, 2: FOR I = 1 TO 78: PRINT "█"; : NEXT I
COLOR 14: LOCATE 2, 19: PRINT " C A L C U L A T I N G D I S C R I M I N A N T "
END SUB
SUB FBUYUK
' LOCATE 12, 41: PRINT "+":
LOCATE 12, 42: PRINT "+":
END SUB
SUB FPRINT (x%, y%, yazi$, renk%)
renkal renk%, A%, B%, C%
renkayar renk%, 0, 0, 0
COLOR renk%: LOCATE x%, y%: PRINT yazi$
FOR E% = 0 TO 63
renkayar renk%, E%, E%, E%
NEXT
FOR rx# = 1 TO 500: NEXT
FOR E% = 63 TO 0 STEP -1
renkayar renk%, E%, E%, E%
NEXT
COLOR 0: LOCATE x%, y%: PRINT SPC(LEN(yazi$));
renkayar renk%, A%, B%, C%
END SUB
SUB renkal (no%, y%, m%, k%)
DIM regs AS RegType
regs.ax = &H1015
regs.bx = no%
INTERRUPT &H10, regs, regs
y% = INT(regs.cx / 256)
m% = regs.cx MOD 256
k% = INT(regs.dx / 256)
END SUB
SUB renkayar (no%, yesil%, mavi%, kirm%)
DIM regs AS RegType
regs.ax = &H1010
regs.bx = no%
regs.cx = 256 * yesil% + mavi%
regs.dx = 256 * kirm%
INTERRUPT &H10, regs, regs
END SUB